home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Highspeed pascal.adf / Demos / FileCopy.pas < prev    next >
Pascal/Delphi Source File  |  1991-12-31  |  2KB  |  78 lines
  1. {$M 10,10,10,10}
  2. Program FileCopy;
  3.  
  4. Uses Dos,Crt,UtilUnit;
  5.  
  6. { Filename: FileCopy.pas      }
  7. { Coder   : Jacob V. Pedersen }
  8. { Coded   : 26-11-1990        }
  9. { Purpose : Example           }
  10.  
  11. Const
  12.         Bsize   = 8000;                 { Size of disk buffer }
  13. Var
  14.         Buffer  : Pointer;
  15.         File1,                          { Source file. }
  16.         File2   : File;                 { Destination file. }
  17.  
  18.  
  19.  
  20. { Copies Source file to Dest file. }
  21. Procedure CopyAFile( Source, Dest : String );
  22. Var
  23.         Reply     : Char;
  24.         BytesRead,
  25.         BytesWrit : Integer;
  26. Begin
  27.   GetMem(Buffer,BSize);
  28.  
  29.   WriteLn;
  30.   If (Not(Exist(Source))) then
  31.     Begin
  32.       Writeln('Cannot access the SOURCE file. (',Source,').');
  33.       HALT;
  34.     End;
  35.  
  36.   If (Exist(Dest)) then
  37.     Begin
  38.       Write('DESTINATION file ',Dest,' already exists. Overwrite (Y/N): ');
  39.       Repeat
  40.         Reply := UpCase(ReadKey);
  41.       Until (Reply IN ['Y','N']);
  42.       WriteLn(Reply);
  43.       If (Reply = 'N') then
  44.         EXIT;
  45.       Writeln;
  46.       Erase(Dest);
  47.     End; { to exists }
  48.  
  49.   Reset(File1, Source );
  50.   Rewrite(File2, Dest );
  51.   Write('Copying from ',Source,' to ',Dest,' ');
  52.   Repeat
  53.     BlockRead(File1, Buffer^, Bsize, BytesRead);
  54.     BlockWrite(File2, Buffer^, BytesRead, BytesWrit);
  55.   Until (BytesRead = 0) or (BytesRead <> BytesWrit);
  56.  
  57.   Close(File1);
  58.   Close(File2);
  59.   If (BytesRead = BytesWrit) then
  60.     Writeln('Ok')
  61.   Else Begin
  62.     Writeln('Insufficient disk space.');
  63.     Erase(Dest);
  64.   End;
  65.  
  66.   FreeMem(Buffer,Bsize);
  67. End; { CopyAFile }
  68.  
  69.  
  70. BEGIN { main }
  71.   If (ParamCount <> 2) then BEGIN
  72.     Writeln('Please enter FROM and TO filename on the command line.');
  73.     Writeln('Use the Program/Arguments requester.');
  74.     Writeln;
  75.   END ELSE
  76.     CopyAFile(ParamStr(1),ParamStr(2));
  77. END.
  78.